﻿{-# OPTIONS_GHC -XRecordWildCards #-}
module XI.Directory.Types where
import Data.Maybe

data Scenario = Scenario {scenario_name :: Maybe String, scenario_chains :: [Chain]} deriving (Show, Eq)
data Chain = Chain {chain_sender :: Sender, chain_receivers :: [Receiver]} deriving (Show, Eq)

data Sender = Sender {s_sys::String, s_cc::String, s_int::String} deriving (Show, Eq)
data Condition = Condition String deriving (Show, Eq, Ord) -- undefined !!!
data Receiver = Receiver {r_cond::(Maybe Condition), r_sys::String, r_ints::[RcvInt]} deriving (Show, Eq)
data RcvInt = RcvInt {ri_cond::(Maybe Condition), r_int::String, mapping::(Maybe String), r_cc::String} deriving (Show, Eq)

data ChainPlain = ChainPlain { 
            ps_sys      :: String, 
            ps_cc       :: String, 
            ps_int      :: String, 
            pmapping    :: Maybe String, 
            pr_int      :: String, 
            pr_cc       :: String, 
            pr_sys      :: String } deriving (Show, Eq)

type CCParam = (CCType, AdapterType)
data CCType = CCSender | CCReceiver	deriving (Eq, Ord)
instance Show CCType where
	show CCSender = "S"
	show CCReceiver = "R"
	
ccType "Receiver" = CCReceiver
ccType "Sender" = CCSender

data AdapterType = JMS | JDBC | File | FTP | RFC | IDoc | HTTP | XI | SOAP | RNIF | CIDX | Mail | Marketplace | BC deriving (Eq, Ord, Show, Read)

data XIObj = 
    Sc {sc_name :: String, sc_ids :: [String]} |
    CC {cc_system :: String, cc_name :: String, cc_param :: CCParam} |	-- ssys, cc, parameters
    SAgg {sender :: String, sender_int :: String, sender_cc :: String} |	-- ssys, sint, cc
    RAgg {sender :: String, receiver :: String, receiver_int :: String, receiver_cc :: String} |	-- {-ssys, sint, -}rsys, rint, cc
    RD {sender :: String, sender_int :: String, cond_receivers :: [((Maybe Condition), String)]}	| -- ssys, sint, [cond, rsys]
    ID {sender :: String, sender_int :: String, receiver :: String, 
        cond_receiver_ints :: [((Maybe Condition), String, (Maybe String))]} | -- ssys, int, rsys, [cond, rint, mapping]
    IP {system :: String}
    deriving (Eq, Ord)

type Configuration = ([Scenario], [XIObj])

readAT :: String -> AdapterType
readAT = read

getAT::[XIObj]->String->String->AdapterType
getAT ccs s cc = if null ccs' then XI else snd . cc_param . head $ ccs' -- type 'XI' is default
	where 
		ccs' = filter (\(CC {..})->(cc_system, cc_name) == (s, cc)) $ filter isCC ccs

isSAreq x = x `elem` [JMS, JDBC, File, FTP, RFC, RNIF, CIDX, Marketplace, BC]
isSAspec x = x `elem` [JMS, JDBC, File, FTP]

getSIfromCC cc
	| isSAreq (snd $ cc_param cc) = Nothing
	| otherwise = Just "http://This.is.not.realised/yet"


-- http://help.sap.com/saphelp_nw70ehp1/helpdata/en/b1/f29e7a56e18a439984a3c6630951d2/content.htm
-- Special Conditions when Using the Sender JMS, JDBC, or File/FTP Adapter
-- In the case of these adapter types, the information about address fields of the message header is determined from the sender agreement that 
-- the communication channel is assigned to. The following conditions apply to sender agreements that use communication channels with these adapter types.
-- ●      The sender channel must not be assigned to more than one sender agreement.
-- ●      No key fields may contain the wildcard character (*).
-- ●      At least the interface (name and namespace) and the sender service must be specified in the sender agreement because the corresponding address fields 
--        in the message must be set uniquely. The remaining fields are optional (see the key fields for the sender agreement).
-- The sender agreement is determined from the sender channel at runtime. The information from the sender agreement is used to construct the address header of the message.

instance Show XIObj where
  show xo = filter (/='"') $ case xo of
    (Sc {..}) -> "Sc" +-+ sc_name +-+ "[" ++ (noCB $ show sc_ids) ++ "]"
    (CC {..}) -> "CC" +-+ cc_system +-+ cc_name +-+ (show $ fst cc_param) +-+ (show $ snd cc_param)
    (SAgg {..}) -> "Agg S" +-+ sender +-+ show sender_int +-+ sender_cc
    (RAgg {..}) -> "Agg R" +-+ sender +-+ receiver +-+ show receiver_int +-+ receiver_cc
    (RD {..}) -> "RD" +-+ sender +-+ show sender_int +-+ (noCB $ show $ map (\(x,y)->(fromMb x, y)) cond_receivers)
    (ID {..}) -> "ID" +-+ sender +-+ (show sender_int) +-+ receiver +-+ 
          (noCB $ show $ map (\(x,y,z)->(fromMb x, y, fromMaybe "-" z)) cond_receiver_ints)
    (IP {..}) -> "IP" +-+ system
    where
      noCB = (map (\x->if x == ',' then ' ' else x)).(filter (`notElem` "[]()"))
      fromMb = fromMaybe "-" . (>>= return . show)

infixr 5 +|+	
a +|+ b = a ++ "|" ++ b
a +-+ b = a ++ " " ++ b

getId x = case x of
  Sc {..} -> "SC" +|+ sc_name
  CC {..} -> "CC" +|+ cc_system +|+ cc_name
  SAgg {..} -> "SAGG" +|+ sender +|+ sender_int 
  RAgg {..} -> "RAGG" +|+ sender +|+ receiver +|+ receiver_int 
  RD {..} -> "RD" +|+ sender +|+ sender_int
  ID {..} -> "ID" +|+ sender +|+ sender_int +|+ receiver
  IP {..} -> "IP" +|+ system
  
determineBy y x
    | cmpId x y = 
        if isAggS x then x { sender_int = f "*/*" sender_int }
        else if isAggR x then x {   sender = f "*" sender,
                                    receiver = f "*" receiver,
                                    receiver_int = f "*/*" receiver_int }
        else if isRD x then x { sender = f "*" sender,
                                sender_int = f "*/*" sender_int }
        else if isID x then x { sender = f "*" sender,
                                receiver = f "*" receiver,
                                sender_int = f "*/*" sender_int }
        else x
    where
        f s g = if g x == s then g y else g x
{-    
    case x of  
        SAgg {..} -> x { sender_int = if sender_int == "*/*" then sender_int y else sender_int }
        RAgg {..} -> x {    sender = if sender == "*" then sender y else sender,
                            receiver = if receiver == "*" then receiver y else receiver,
                            receiver_int = if receiver_int == "*/*" then receiver_int y else receiver_int }
--        RD {..} -> "RD" +|+ sender +|+ sender_int
--        ID {..} -> "ID" +|+ sender +|+ sender_int +|+ receiver
        otherwise -> x
-}
	
isAggS (SAgg {..}) = True
isAggS _ = False
isRD (RD {..}) = True
isRD _ = False
isID (ID {..}) = True
isID _ = False
isAggR (RAgg {..}) = True
isAggR _ = False
isSc (Sc {..}) = True
isSc _ = False
isCC (CC {..}) = True
isCC _ = False
isIP (IP {..}) = True
isIP _ = False

-- Сравнение идентификаторов. При этом x или y может содержать * и */*
cmpId x y = go (getId x) (getId y)
	where
        go [] [] = True
        go [] y = False
        go x [] = False
        go a b = cmp' (part a) (part b)
        part = (\(a,b) -> (a, drop 1 b)) . break (=='|')
        cmp' (a1, a2) (b1, b2) = if any (`elem` ["*", "*/*"]) [a1, b1] || a1 == b1 then go a2 b2 else False
	
